home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_200 / 231_01 / interp.c < prev    next >
Text File  |  1987-06-15  |  12KB  |  429 lines
  1. /*
  2.     Little Smalltalk
  3.         bytecode interpreter
  4.         timothy a. budd
  5. */
  6. /*
  7.     The source code for the Little Smalltalk System may be freely
  8.     copied provided that the source of all files is acknowledged
  9.     and that this condition is copied with each file.
  10.  
  11.     The Little Smalltalk System is distributed without responsibility
  12.     for the performance of the program and without any guarantee of
  13.     maintenance.
  14.  
  15.     All questions concerning Little Smalltalk should be addressed to:
  16.  
  17.         Professor Tim Budd
  18.         Department of Computer Science
  19.         Oregon State University
  20.         Corvallis, Oregon
  21.         97331
  22.         USA
  23. */
  24. # include <stdio.h>
  25. # include "object.h"
  26. # include "drive.h"
  27. # include "cmds.h"
  28. # include "interp.h"
  29. # include "process.h"
  30. # include "number.h"
  31. # include "string.h"
  32. # include "symbol.h"
  33. # include "byte.h"
  34. # include "block.h"
  35. # include "primitive.h"
  36.  
  37. int opcount[16], ohcount, spcount[16];
  38. extern object *o_smalltalk;    /* value of pseudo variable smalltalk */
  39. extern object *fnd_class();    /* used to find classes from names */
  40.  
  41. static mstruct *fr_interp = 0;    /* interpreter memory free list */
  42. int ca_terp = 0;        /* counter for interpreter allocations */
  43.  
  44. /* cr_interpreter - create a new interpreter */
  45. interpreter *cr_interpreter(sender, receiver, literals, bitearray, context)
  46. interpreter *sender;
  47. object *literals, *bitearray, *receiver, *context;
  48. {    interpreter *new;
  49.     class *rclass;
  50.     int isize;
  51.  
  52.     if (fr_interp) {
  53.         new = (interpreter *) fr_interp;
  54.         fr_interp = fr_interp->mlink;
  55.         }
  56.     else {
  57.         new = structalloc(interpreter);
  58.         ca_terp++;
  59.         }
  60.  
  61.     new->t_ref_count = 0;
  62.     new->t_size = INTERPSIZE;
  63.  
  64.     new->creator = (interpreter *) 0;
  65.     if (sender)
  66.         sassign(new->sender, sender);
  67.     else
  68.         sassign(new->sender, (interpreter *) o_nil);
  69.     sassign(new->literals, literals);
  70.     sassign(new->bytecodes, bitearray);
  71.     sassign(new->receiver, receiver);
  72.     rclass = (class *) fnd_class(receiver);
  73.     if ((! rclass) || ! is_class(rclass))
  74.         isize = 25;
  75.     else {
  76.         isize = rclass->stack_max;
  77.         }
  78.     sassign(new->context, context);
  79.     sassign(new->stack, new_obj((class *) 0, isize, 1));
  80.     new->stacktop = &(new->stack)->inst_var[0];
  81.     new->currentbyte = byte_value(new->bytecodes);
  82.     return(new);
  83. }
  84.  
  85. /* free_terpreter - return an unused interpreter to free list */
  86. free_terpreter(anInterpreter)
  87. interpreter *anInterpreter;
  88. {
  89.     if (! is_interpreter(anInterpreter))
  90.         cant_happen(8);
  91.  
  92.     obj_dec((object *) anInterpreter->sender);
  93.     obj_dec(anInterpreter->receiver);
  94.     obj_dec(anInterpreter->bytecodes);
  95.     obj_dec(anInterpreter->literals);
  96.     obj_dec(anInterpreter->context);
  97.     obj_dec(anInterpreter->stack);
  98.  
  99.     ((mstruct *) anInterpreter)->mlink = fr_interp;
  100.     fr_interp = (mstruct *) anInterpreter;
  101. }
  102.  
  103. /* copy_arguments - copy an array of arguments into the context */
  104. copy_arguments(anInterpreter, argLocation, argCount, argArray)
  105. interpreter *anInterpreter;
  106. int argLocation, argCount;
  107. object **argArray;
  108. {    object *context = anInterpreter->context;
  109.     int i;
  110.  
  111.     for (i = 0; i < argCount; argLocation++, i++) {
  112.         assign(context->inst_var[ argLocation ], argArray[i]);
  113.         }
  114. }
  115.  
  116. # define push(x) {assign(*(anInterpreter->stacktop), x); \
  117.             anInterpreter->stacktop++;}
  118.  
  119. /* push_object - push a returned value on to an interpreter stack */
  120. push_object(anInterpreter, anObject)
  121. interpreter *anInterpreter;
  122. object *anObject;
  123. {
  124.     push(anObject); /* what? no bounds checking?!? */
  125. }
  126.  
  127. # define nextbyte(x) {x = uctoi(*anInterpreter->currentbyte);\
  128. anInterpreter->currentbyte++;}
  129. # define instvar(x) (anInterpreter->receiver)->inst_var[ x ]
  130. # define tempvar(x) (anInterpreter->context)->inst_var[ x ]
  131. # define lit(x)     (anInterpreter->literals)->inst_var[ x ]
  132. # define popstack() (*(--anInterpreter->stacktop))
  133. # define decstack(x) (anInterpreter->stacktop -= x)
  134. # define skip(x)    (anInterpreter->currentbyte += x )
  135.  
  136. /* resume - resume executing bytecodes associated with an interpreter */
  137. resume(anInterpreter)
  138. register interpreter *anInterpreter;
  139. {
  140.     int highBits;
  141.     register int lowBits;
  142.     object *tempobj, *receiver, *fnd_super();
  143.     interpreter *sender;
  144.     int i, j, numargs, arglocation;
  145.     char *message;
  146.  
  147.     while(1) {
  148.         nextbyte(highBits);
  149.         lowBits = highBits % 16;
  150.         highBits /= 16;
  151.  
  152.         switchtop:
  153.         opcount[highBits]++;
  154.         switch(highBits) {
  155.             default: cant_happen(9);
  156.                 break;
  157.  
  158.             case 0:    /* two bit form */
  159.                 highBits = lowBits;
  160.                 nextbyte(lowBits);
  161.                 goto switchtop;
  162.  
  163.             case 1: /* push instance variable */
  164.                 push(instvar(lowBits));
  165.                 break;
  166.  
  167.             case 2: /* push context value */
  168.                 push(tempvar(lowBits));
  169.                 break;
  170.  
  171.             case 3: /* literals */
  172.                 push(lit(lowBits));
  173.                 break;
  174.  
  175.             case 4: /* push class */
  176.                 tempobj = lit(lowBits);
  177.                 if (! is_symbol(tempobj)) cant_happen(9);
  178.                 tempobj = primitive(FINDCLASS, 1, &tempobj);
  179.                 push(tempobj);
  180.                 break;
  181.  
  182.             case 5: /* special literals */
  183.                 if (lowBits < 10)
  184.                     tempobj = new_int(lowBits);
  185.                 else if (lowBits == 10)
  186.                     tempobj = new_int(-1);
  187.                 else if (lowBits == 11)
  188.                     tempobj = o_true;
  189.                 else if (lowBits == 12)
  190.                     tempobj = o_false;
  191.                 else if (lowBits == 13)
  192.                     tempobj = o_nil;
  193.                 else if (lowBits == 14)
  194.                     tempobj = o_smalltalk;
  195.                 else if (lowBits == 15)
  196.                     tempobj = (object *) runningProcess;
  197.                 else if ((lowBits >= 30) && (lowBits < 60)) {
  198.                     /* get class */
  199.                     tempobj =
  200.                         new_sym(classpecial[lowBits-30]);
  201.                     tempobj = primitive(FINDCLASS, 1,
  202.                         &tempobj);
  203.                     }
  204.                 else tempobj = new_int(lowBits);
  205.                 push(tempobj);
  206.                 break;
  207.  
  208.             case 6: /* pop and store instance variable */
  209.                 assign(instvar(lowBits), popstack());
  210.                 break;
  211.  
  212.             case 7: /* pop and store in context */
  213.                 assign(tempvar(lowBits), popstack());
  214.                 break;
  215.  
  216.             case 8: /* send a message */
  217.                 numargs = lowBits;
  218.                 nextbyte(i);
  219.                 tempobj = lit(i);
  220.                 if (! is_symbol(tempobj)) cant_happen(9);
  221.                 message = symbol_value(tempobj);
  222.                 goto do_send;
  223.  
  224.             case 9: /* send a superclass message */
  225.                 numargs = lowBits;
  226.                 nextbyte(i);
  227.                 tempobj = lit(i);
  228.                 if (! is_symbol(tempobj)) cant_happen(9);
  229.                 message = symbol_value(tempobj);
  230.                 receiver =
  231.                     fnd_super(anInterpreter->receiver);
  232.                 goto do_send2;
  233.  
  234.             case 10: /* send a special unary message */
  235.                 numargs = 0;
  236.                 message = unspecial[lowBits];
  237.                 goto do_send;
  238.  
  239.             case 11: /* send a special binary message */
  240.                 numargs = 1;
  241.                 message = binspecial[lowBits];
  242.                 goto do_send;
  243.  
  244.             case 12: /* send a special arithmetic message */
  245.                 tempobj = *(anInterpreter->stacktop - 2);
  246.                 if (! is_integer(tempobj)) goto ohwell;
  247.                 i = int_value(tempobj);
  248.                 tempobj = *(anInterpreter->stacktop - 1);
  249.                 if (! is_integer(tempobj)) goto ohwell;
  250.                 j = int_value(tempobj);
  251.                 decstack(2);
  252.                 switch(lowBits) {
  253.                     case 0: i += j; break;
  254.                     case 1: i -= j; break;
  255.                     case 2: i *= j; break;
  256.                     case 3: if (i < 0) i = -i;
  257.                         i %= j; break;
  258.                     case 4: if (j < 0) i >>= (-j);
  259.                         else i <<= j; break;
  260.                     case 5: i &= j; break;
  261.                     case 6: i |= j; break;
  262.                     case 7: i = (i < j); break;
  263.                     case 8: i = (i <= j); break;
  264.                     case 9: i = (i == j); break;
  265.                     case 10: i = (i != j); break;
  266.                     case 11: i = (i >= j); break;
  267.                     case 12: i = (i > j); break;
  268.                     case 13: i %= j; break;
  269.                     case 14: i /= j; break;
  270.                     case 15: i = (i < j) ? i : j;
  271.                         break;
  272.                     case 16: i = (i < j) ? j : i;
  273.                         break;
  274.                     default: cant_happen(9);
  275.                     }
  276.                 if ((lowBits < 7) || (lowBits > 12))
  277.                     tempobj = new_int(i);
  278.                 else tempobj = (i ? o_true : o_false);
  279.                 push(tempobj);
  280.                 break;
  281.  
  282.                 ohwell: /* oh well, send message */
  283.                 ohcount++;
  284.                 numargs = 1;
  285.                 message = arithspecial[lowBits];
  286.                 goto do_send;
  287.  
  288.             case 13: /* send a special ternary keyword messae */
  289.                 numargs = 2;
  290.                 message = keyspecial[lowBits];
  291.                 goto do_send;
  292.  
  293.             case 14: /* block creation */
  294.                 numargs = lowBits;
  295.                 if (numargs)
  296.                     nextbyte(arglocation);
  297.                 nextbyte(i);    /* size of block */
  298.                 push(new_block(anInterpreter, numargs,
  299.                     arglocation));
  300.                 skip(i);
  301.                 break;
  302.  
  303.